home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / win / pascal / bezier.exe / BEZ.PAS < prev    next >
Pascal/Delphi Source File  |  1992-02-18  |  16KB  |  579 lines
  1. {****  Bezier 1.0 Doug Overmyer ********}
  2. program Bez;
  3. {$R BEZ.RES}
  4. uses WinTypes, WinProcs, WObjects,Strings,Icons;
  5. const
  6.   BZ_Name =  'BΘzier Demo';
  7.   idm_BZChange = 301;
  8.   idm_BZShowHide=302;
  9.   um_ReSize    = 401;
  10.   id_IG1   =      600;
  11.   id_Icon1 =      601;
  12.   id_Icon2 =      602;
  13.   id_Icon3 =      603;
  14.   id_Icon4 =      604;
  15.   id_Icon5 =      605;
  16.   id_Icon6 =      606;
  17.   id_Icon7 =      607;
  18.   id_Icon8 =      608;
  19.   bs_Custom =      99;
  20.   IWidth     =     32;
  21.   BEZ_DEPTH  =      5;
  22.   NUM_BEZPTS =     33;
  23.   st_NotStart = 0;
  24.   st_DragHand1  = 1;
  25.   st_WaitCtrl2  = 2;
  26.   st_DragHand2  = 3;
  27.   md_DrawBezier = 1;
  28. {**********************  TYPES      ******************************}
  29. type
  30.   TBZApp = object(TApplication)
  31.   procedure InitMainWindow; virtual;
  32. end;
  33.  
  34. PBezPoint = ^TBezPoint;
  35. TBezPoint = object(TObject)
  36.     C1,H1,H2,C2:TPoint;
  37.   constructor Init(NewC1,NewH1,NewH2,NewC2:TPoint);
  38. end;
  39.  
  40. PBZToolbar = ^TBZToolbar;
  41. TBZToolbar = object(TWindow)
  42.     Icon:Array[0..8] of PIcon;
  43.   IG1:PIconGroup;
  44.   Orientation:Integer;
  45.   constructor Init(AParent:PWindowsObject;ATitle:PChar);
  46.   destructor Done;virtual;
  47.   procedure WMDrawItem(var Msg:TMessage);virtual wm_First+wm_DrawItem;
  48.   procedure UMReSize(var Msg: TMessage); virtual wm_User + um_ReSize;
  49.   procedure WMCommand(Var Msg:TMessage);virtual wm_First+wm_Command;
  50.   procedure WMNCLButtonDblClk(var Msg:TMessage);virtual wm_First+
  51.       wm_NCLButtonDblClk;
  52.   procedure ToggleOrientation;
  53. end;
  54.  
  55. PBezTool = ^TBezTool;
  56. TBezTool = object
  57.     DC:HDc;
  58.   InPt:TPoint;
  59.   LDFact:Integer;
  60.   State:Integer;
  61.     Ctrl1,Hand1,Hand2,Ctrl2:TPoint;
  62.   BezPts:Array[0..NUM_BEZPTS] of TPoint;
  63.     BezPtsIndx:Integer;
  64.     constructor Init;
  65.   destructor Done;virtual;
  66.   procedure SetMode(HWin:HWnd; Msg:TMessage);
  67.   procedure WMLButtonDown(HWin:Hwnd;var Msg:TMessage);virtual;
  68.   procedure WMRButtonDown(HWin:HWnd;var Msg:TMessage);virtual;
  69.   procedure WMMouseMove(HWin:HWnd;var Msg:TMessage);virtual;
  70.   procedure WMLButtonUp(HWin:HWnd;var Msg:TMessage);virtual;
  71.   procedure DrawBez(TheDC:HDC;C1,H1,H2,C2:TPoint);virtual;
  72.   procedure SubDivideBez(p0,p1,p2,p3:TPoint;BezDepth:Integer);virtual;
  73.   procedure DrawHandle(TheDC:HDc;p,q:TPoint);virtual;
  74. end;
  75.  
  76.  
  77. PBZWindow = ^TBZWindow;
  78. TBZWindow = object(TWindow)
  79.     ToolBar:PBZToolbar;
  80.   BezTool:PBezTool;
  81.   lbColor:TColorRef;
  82.   ColorIndx:Integer;
  83.   RedPen,BezPen:HPen;
  84.   Picture:PCollection;
  85.   Mode:Integer;
  86.   Cross,Arrow:HCursor;
  87.   constructor Init(ATitle: PChar);
  88.   destructor Done; virtual;
  89.   procedure SetupWindow;virtual;
  90.     procedure WMSize(var Msg: TMessage); virtual wm_First + wm_Size;
  91.     procedure IDIcon1(Var Msg:TMessage);virtual wm_User+id_Icon1;
  92.     procedure IDIcon2(Var Msg:TMessage);virtual wm_User+id_Icon2;
  93.     procedure IDIcon3(Var Msg:TMessage);virtual wm_User+id_Icon3;
  94.     procedure IDIcon4(Var Msg:TMessage);virtual wm_User+id_Icon4;
  95.   procedure WMLButtonDown(var Msg:TMessage);virtual wm_First+wm_LButtonDown;
  96.   procedure WMRButtonDown(var Msg:TMessage);virtual wm_First+wm_rButtonDown;
  97.   procedure WMMouseMove(var Msg:TMessage);virtual wm_First+wm_MouseMove;
  98.   procedure WMLButtonUp(var Msg:TMessage);virtual wm_First+wm_LButtonUp;
  99.   procedure Paint(PaintDC:HDC;var PaintInfo:TPaintStruct);virtual;
  100.   procedure DrawCoords(ADC:HDC);
  101. end;
  102. {**********************  GLOBALS   ******************************}
  103. var
  104.     MainWin:PBZWindow;
  105.  
  106. function Tenary(Exp:Boolean;T,F:LongInt):LongInt;
  107. begin
  108.     if Exp then Tenary := T else Tenary := F;
  109. end;
  110. {**********************  METHODS    ******************************}
  111. procedure TBZApp.InitMainWindow;
  112. begin
  113.   MainWindow := New(PBZWindow, Init(BZ_Name));
  114.   MainWin := PBZWindow(MainWindow);
  115. end;
  116. {**********************  TBZWindow  *******************************}
  117. constructor TBZWindow.Init(ATitle: PChar);
  118. begin
  119.   TWindow.Init(nil, ATitle);
  120.   with Attr do
  121.       begin
  122.     X := 50; Y := 50; W := 500; H := 300;
  123.       end;
  124.     ToolBar := New(PBZToolbar,Init(@Self,'Tools'));
  125.   BezTool := New(PBezTool,Init);
  126.   lbColor := RGB(0,0,0);
  127.   ColorIndx := 0;
  128.   RedPen := CreatePen(ps_Solid,1,RGB(255,0,0));
  129.   BezPen := CreatePen(ps_Solid,1,RGB(0,0,0));
  130.     Picture := New(PCollection,Init(10,10));
  131.   Mode := 0;
  132. end;
  133.  
  134. destructor TBZWindow.Done;
  135. var
  136.     Msg:TMessage;
  137. begin
  138.   TWindow.Done;
  139.   Dispose(BezTool,Done);
  140.   if BezPen <> 0 then
  141.       DeleteObject(BezPen);
  142.   DeleteObject(RedPen);
  143.   Dispose(Picture,Done);
  144. end;
  145.  
  146. procedure TBZWindow.SetupWindow;
  147. var
  148.     SysMenu:HMenu;
  149. begin
  150.     TWindow.SetupWindow;
  151.     SetClassWord(HWindow,GCW_HIcon,LoadIcon(HInstance,'BZ_Icon'));
  152.   if ToolBar <> nil then
  153.         SendMessage(ToolBar^.HWindow,wm_User+um_ReSize,0,0);
  154.   Cross := LoadCursor(0,idc_Cross);
  155.   Arrow := LoadCursor(0,idc_Arrow);
  156. end;
  157.  
  158. procedure TBZWindow.WMSize(var Msg: TMessage);
  159. begin
  160.   TWindow.WMSize(Msg);
  161.   if ToolBar <> nil then    {optional follow-along}
  162.         SendMessage(ToolBar^.HWindow,wm_User+um_ReSize,0,0);
  163. end;
  164.  
  165. procedure TBZWindow.IDIcon1(var Msg:TMessage);
  166. begin
  167.     Mode := md_DrawBezier;
  168.   Cross := LoadCursor(0,idc_Cross);
  169.   SetClassWord(HWindow,gcw_HCursor,Cross);
  170. end;
  171.  
  172. procedure TBZWindow.IDIcon2(var Msg:TMessage);
  173. var
  174.     C:TPoint;
  175. begin
  176.     Mode := 0;
  177.   SetClassWord(HWindow,gcw_HCursor,Arrow);
  178.     Picture^.FreeAll;
  179.   C.X := 0; C.Y := 0;
  180.     InvalidateRect(HWindow,nil,True);
  181. end;
  182.  
  183. procedure TBZWindow.IDIcon3(var Msg:TMessage);
  184. begin
  185.     Mode := 0;
  186.   SetClassWord(HWindow,gcw_HCursor,Arrow);
  187.     Inc(ColorIndx);
  188.   If ColorIndx > 9 then ColorIndx := 0;
  189.     case ColorIndx of
  190.       0:lbColor := RGB(0,0,0);
  191.       1:lbColor := RGB(0,0,255);
  192.       2:lbColor := RGB(255,0,0);
  193.       3:lbColor := RGB(255,0,255);
  194.       4:lbColor := RGB(0,255,0);
  195.       5:lbColor := RGB(0,255,255);
  196.       6:lbColor := RGB(255,255,0);
  197.       7:lbColor := RGB(255,255,255);
  198.       8:lbColor := RGB(192,192,192);
  199.       9:lbColor := RGB(128,128,128);
  200.   end;
  201.   if BezPen <> 0 then
  202.       DeleteObject(BezPen);
  203.   BezPen := CreatePen(ps_Solid,1,lbColor);
  204. end;
  205.  
  206. procedure TBZWindow.IDIcon4(var Msg:TMessage);
  207. begin
  208.     CloseWindow;
  209. end;
  210.  
  211. procedure TBZWindow.WMLButtonDown(var Msg:TMessage);
  212. begin
  213.     Case Mode of
  214.     md_DrawBezier:BezTool^.WMLButtonDown(HWindow,Msg);
  215.   end;
  216. end;
  217.  
  218. procedure TBZWindow.WMRButtonDown(var Msg:TMessage);
  219. begin
  220.     Picture^.FreeAll;
  221.     InvalidateRect(HWindow,nil,True);
  222. end;
  223.  
  224. procedure TBZWindow.WMMouseMove(var Msg:TMessage);
  225. begin
  226.     case Mode of
  227.       md_DrawBezier:    BezTool^.WMMouseMove(HWindow,Msg);
  228.     end;
  229. end;
  230. procedure TBZWindow.WMLButtonUp(var Msg:TMessage);
  231. var
  232.     ADC:HDC;
  233. begin
  234.     case Mode of
  235.       md_DrawBezier:
  236.         begin
  237.       BezTool^.WMLButtonUp(HWindow,Msg);
  238.             ADC := GetDC(HWindow);
  239.       DrawCoords(ADC);
  240.           ReleaseDC(HWindow,ADC);
  241.       end;
  242.   end;
  243. end;
  244.  
  245. procedure TBZWindow.Paint(PaintDC:HDC;var PaintInfo:TPaintStruct);
  246. var
  247.   Indx:Integer;
  248.   BP:PBezPoint;
  249. begin
  250.   DrawCoords(PaintDC);
  251.   SetMapMode(PaintDC,mm_Twips);
  252.   if Picture^.Count > 0 then
  253.     for Indx := 0 to (Picture^.Count -1) do
  254.         begin
  255.       BP := Picture^.At(Indx);
  256.             BezTool^.DrawBez(PaintDC,BP^.C1,BP^.H1,BP^.H2,BP^.C2);
  257.       end;
  258. end;
  259.  
  260. procedure TBZWindow.DrawCoords(ADC:HDC);
  261. var
  262.     BezPts : Record
  263.       C1X,C1Y,H1X,H1Y,C2X,C2Y,H2X,H2Y:Integer;
  264.   end;
  265.   OutStr:Array[0..255] of Char;
  266.   Indx:Integer;
  267.   BP:PBezPoint;
  268. begin
  269.     StrCopy(OutStr,'');
  270.   FillChar(OutStr,250,' ');
  271.   TextOut(ADC,5,5,OutStr,StrLen(OutStr));
  272.   if Picture^.Count > 0 then
  273.       begin
  274.       BP := Picture^.At(Picture^.Count-1);
  275.       BezPts.C1X := BP^.C1.x;
  276.       BezPts.C1Y := BP^.C1.Y;
  277.       BezPts.H1X := BP^.H1.x;
  278.       BezPts.H1y := BP^.H1.y;
  279.       BezPts.C2X := BP^.C2.x;
  280.       BezPts.C2y := BP^.C2.y;
  281.       BezPts.H2X := BP^.H2.x;
  282.       BezPts.H2y := BP^.H2.y;
  283.     end
  284.   else
  285.         begin
  286.       BezPts.C1X := 0;
  287.       BezPts.C1Y := 0;
  288.       BezPts.H1X := 0;
  289.       BezPts.H1y := 0;
  290.       BezPts.C2X := 0;
  291.       BezPts.C2y := 0;
  292.       BezPts.H2X := 0;
  293.       BezPts.H2y := 0;
  294.     end;
  295.  
  296.     wvsprintf(OutStr,'C1(%i,%i) H1(%i,%i) C2(%i,%i) H2(%i,%i)',BezPts);
  297.     TextOut(ADC,5,5,OutStr,StrLen(OutStr));
  298. end;
  299.  
  300. {**********************   TBezTool    *****************************}
  301. constructor TBezTool.Init;
  302. begin
  303.     DC := 0;
  304.   State := 0;
  305.     Ctrl1.x := 0;Ctrl1.y := 0;Hand1.x :=0;Hand1.Y := 0;
  306.     C